An Exploratory Data and Network Analysis of Movies

Gross and Budget

Since gross and budget have too many missing values (874 and 488), and we want to keep these two variables for the following analysis, we can only delete rows with null values for gross and budget because imputation will not do a good job here.

# Find NA values for gross and budget
movie_metadata <- movie_metadata[!is.na(movie_metadata$gross), ]
movie_metadata <- movie_metadata[!is.na(movie_metadata$budget), ]
dim(movie_metadata)

## [1] 3857   28

The difference in observations have decreased by 4998 - 3857 = 1141 which is luckily only 22.8% of the previous total observations. Let’s have a look at how many complete cases we have.

Content Rating

# Look at all the different types of content ratings
table(movie_metadata$content_rating)

## 
##            Approved         G        GP         M     NC-17 Not Rated 
##        51        17        91         1         2         6        42 
##    Passed        PG     PG-13         R   Unrated         X 
##         3       573      1314      1723        24        10

According to the history of naming these different content ratings, we find M = GP = PG, X = NC-17. We want to replace M and GP with PG, replace X with NC-17, because these two are what we use nowadays.

movie_metadata$content_rating[movie_metadata$content_rating == 'M']   <- 'PG' 
movie_metadata$content_rating[movie_metadata$content_rating == 'GP']  <- 'PG' 
movie_metadata$content_rating[movie_metadata$content_rating == 'X']   <- 'NC-17'

We want to replace Approved, Not Rated, Passed, Unrated with the most common rating R.

movie_metadata$content_rating[movie_metadata$content_rating == 'Approved']  <- 'R' 
movie_metadata$content_rating[movie_metadata$content_rating == 'Not Rated'] <- 'R' 
movie_metadata$content_rating[movie_metadata$content_rating == 'Passed']    <- 'R' 
movie_metadata$content_rating[movie_metadata$content_rating == 'Unrated']   <- 'R' 
movie_metadata$content_rating <- factor(movie_metadata$content_rating)
table(movie_metadata$content_rating)

## 
##           G NC-17    PG PG-13     R 
##    51    91    16   576  1314  1809

Blanks should be taken as missing value. Since these missing values cannot be replaced with reasonable data, we delete these rows.

# Remove rows with blank content ratings
movie_metadata <- movie_metadata[!(movie_metadata$content_rating %in% ""),]

Gross and Budget

We have gross and budget information. So let’s add two colums: profit and percentage return on investment for further analysis.

# add profit and return of investment column
movie_metadata <- movie_metadata %>% 
  mutate(profit = gross - budget,
         return_on_investment_perc = (profit/budget)*100)

Colour

Next, we take a look at the influence of colour vs black and white.

# Get colour display types of movies
table(movie_metadata$color)

## 
##                   Black and White            Color 
##                2              124             3680

Since 3.4%of the data is in black and white, we can remove the color column it.

# delete colour
movie_metadata <- subset(movie_metadata, select = -c(color))

Language

Let’s have a look at the different languages contained within the dataset.

# Look at different languages
table(movie_metadata$language)

## 
##            Aboriginal     Arabic    Aramaic    Bosnian  Cantonese 
##          2          2          1          1          1          7 
##      Czech     Danish       Dari      Dutch    English   Filipino 
##          1          3          2          3       3644          1 
##     French     German     Hebrew      Hindi  Hungarian Indonesian 
##         34         11          2          5          1          2 
##    Italian   Japanese     Kazakh     Korean   Mandarin       Maya 
##          7         10          1          5         14          1 
##  Mongolian       None  Norwegian    Persian Portuguese   Romanian 
##          1          1          4          3          5          1 
##    Russian    Spanish       Thai Vietnamese       Zulu 
##          1         24          3          1          1

Almost 95% movies are in English, which means this variable is nearly constant. Let’s remove it.

Country

Next, we can look at the different types of countries.

table(movie_metadata$country)

## 
##    Afghanistan      Argentina          Aruba      Australia        Belgium 
##              1              3              1             40              1 
##         Brazil         Canada          Chile          China       Colombia 
##              5             63              1             13              1 
## Czech Republic        Denmark        Finland         France        Georgia 
##              3              9              1            103              1 
##        Germany         Greece      Hong Kong        Hungary        Iceland 
##             79              1             13              2              1 
##          India      Indonesia           Iran        Ireland         Israel 
##              5              1              4              7              2 
##          Italy          Japan         Mexico    Netherlands       New Line 
##             11             15             10              3              1 
##    New Zealand         Norway  Official site           Peru    Philippines 
##             11              4              1              1              1 
##         Poland        Romania         Russia   South Africa    South Korea 
##              1              2              3              3              8 
##          Spain         Taiwan       Thailand             UK            USA 
##             22              2              4            316           3025 
##   West Germany 
##              1

Around 79% movies are from USA, 8% from UK, 13% from other countries. So we group other countries together to make this categorical variable with less levels: USA, UK, Others.

levels(movie_metadata$country) <- c(levels(movie_metadata$country), "Others")
movie_metadata$country[(movie_metadata$country != 'USA')&(movie_metadata$country != 'UK')] <- 'Others' 
movie_metadata$country <- factor(movie_metadata$country)
table(movie_metadata$country)

## 
## Others     UK    USA 
##    465    316   3025

Now that we’ve cleaned up our dataset, we can now continue to explore our data even further! In the next section we will be looking at genres, movie popularity, gross, profit, and many more other aspects pertinent to our data.

Top Genres

genre = movie_metadata['genres']
genre = data.frame(table(genre))
genre = genre[order(genre$Freq,decreasing=TRUE),]

# Top 20 genres with the most movies
ggplot(genre[1:20,], aes(x=reorder(factor(genre), Freq), y=Freq, alpha=Freq)) + 
  geom_bar(stat = "identity", fill="blue") + 
  geom_text(aes(label=Freq),hjust=1.2, size=3.5)+
  xlab("Genre") + 
  ylab("Number of Movies") + 
  ggtitle("Top 20 genres with the most movies") + 
  coord_flip()

Split Genres

As you can see, movies have multiple genres that its associated with. For analysis purposes, we choose to use the first word in the genre column, as this is likely the most accurate description.

head(movie_metadata$genres)

## [1] "Action|Adventure|Fantasy|Sci-Fi" "Action|Adventure|Fantasy"       
## [3] "Action|Adventure|Thriller"       "Action|Thriller"                
## [5] "Action|Adventure|Sci-Fi"         "Action|Adventure|Romance"

Let’s split the genres separated by “|” into 8 different columns.

# Split on "|"
genres_split <- str_split(movie_metadata$genres, pattern="[|]", n=2)

# Create Matrix
genres_matrix <- do.call(rbind, strsplit(movie_metadata$genres, '[|]'))

# Dataframe of genres
genres_df <- as.data.frame(genres_matrix)

genre_df consists of 8 columns, each with different genres. Let’s have a look at the frequency of all the genres.

# Collapse all genres into one column
genres_one_col <- gather(genres_df) %>% 
  select(value)

# Plot frequency of first column
genres_one_col %>%
  group_by(value) %>% 
  tally() %>% 
  filter(n >= 30) %>% 
  ggplot() +
  geom_bar(aes(x = value, y=n), stat="identity") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) +
  xlab("Genre") +
  ylab("Frequency") +
  NULL

It is evident that the Drama and Comedy genre are the most popular to be produced. However, this does not mean that they are the most profitable, returning successful ROI’s. This will further be explored.

Previously we assumed that the first genre is the most applicable, therefore, we choose the first column as the genre for the movie and append it to the dataframe.

# Take old genres column away
movie_metadata <- subset(movie_metadata, select = -c(genres))

# Take first column of genres_df and add it to MAIN df
movie_metadata$genre <- genres_df$V1

How does this distribution look like over the years? Lets have a look at the frequency of genres between the period of 1980 and 2016.

movie_metadata %>%
 group_by(title_year, genre) %>%
 summarise(count = n()) %>%
 ggplot(aes(title_year, as.factor(genre))) +
 geom_tile(aes(fill=count),colour="white") +
 scale_fill_gradient(low="light blue",high = "dark blue") +
 xlab("Year of Movie") +
 ylab("Genre of Movie") +
 ggtitle("Heat Map of Movie Genres Produced Over the Years") +
  theme(panel.background = element_blank())

The heat map allows us to see that the popular genres with high frequencys are constantly being produced more and more often over the years. It is evident by the darker shades of blue becomming more prominent in the latter years.

Which Genres are Popular?

In our dataset we have Facebook Likes and IMDB scores associated with a movie. This can help give us an indication of how popular each genre is.

# Add column for total facebook likes
movie_metadata$total_facebook_likes <- movie_metadata$director_facebook_likes + 
  movie_metadata$actor_3_facebook_likes + movie_metadata$actor_1_facebook_likes +
  movie_metadata$cast_total_facebook_likes + movie_metadata$actor_2_facebook_likes + 
  movie_metadata$movie_facebook_likes

# creating a data frame containing avg score, avg votes and avg fb likes
score_votes_likes <- movie_metadata %>% 
  group_by(genre) %>%
  summarise(count = n(),
            avg_score = round(mean(imdb_score), 1),
            avg_votes = mean(num_voted_users),
            avg_facebook_likes = mean(total_facebook_likes),
            avg_reviews = mean(num_user_for_reviews)) %>%
  filter(count > 10)

# arranging data frame by average score
arr_score <- arrange(score_votes_likes, desc(avg_facebook_likes))

as.data.frame(score_votes_likes)

##          genre count avg_score avg_votes avg_facebook_likes avg_reviews
## 1       Action   937       6.3 145049.12          38762.692    462.1942
## 2    Adventure   356       6.5 133549.07          40494.340    355.0365
## 3    Animation    43       6.7  83318.51          30471.674    202.0698
## 4    Biography   200       7.1 100233.72          41000.900    260.4650
## 5       Comedy   997       6.1  64763.60          23896.765    197.9388
## 6        Crime   247       6.9 130843.95          33857.397    362.5789
## 7  Documentary    32       6.8  16159.19           5623.312    126.3750
## 8        Drama   667       6.8  85462.68          31889.940    319.7301
## 9      Fantasy    37       6.3  87311.14          25452.270    374.7027
## 10      Horror   152       5.7  66091.12          21356.158    406.8750
## 11     Mystery    24       6.6 180824.04          35571.625    570.2500

# genre wise distribution of scores using a custom plot function  
facet_hist_plot(movie_metadata$imdb_score, 
                "Genre",
                bwidth = 0.1)+
  scale_x_continuous(breaks = seq(0, 9.3, 1)) 

# plotting 10 highest rated genres 
bar_plot(arr_score[1:10,],
         arr_score[1:10,]$avg_score,
         arr_score[1:10,]$avg_score,
         "| Average Score:",
         "Genres",
         "Average IMDB Score",
         "Top 10 IMDB Scores Per Genre",
         deci = 1)

# plotting 10 highest rated genres 
bar_plot(arr_score[1:10,],
         arr_score[1:10,]$avg_facebook_likes,
         arr_score[1:10,]$avg_facebook_likes,
         "| Average Score:",
         "Genres",
         "Average Facebook Likes",
         "Top 10 Facebook Likes Per Genre",
         deci = 1)

Commercial success Vs Critical acclaim

movie_metadata %>%
  top_n(15, profit) %>%
  ggplot(aes(x = imdb_score, y = gross/10^6, size = profit/10^6, color = content_rating)) + 
  geom_point() + 
  geom_hline(aes(yintercept = 600)) + 
  geom_vline(aes(xintercept = 7.75)) + 
  geom_text_repel(aes(label = movie_title), size = 4) +
  xlab("Imdb score") + 
  ylab("Gross money earned in million dollars") + 
  ggtitle("Commercial success Vs Critical acclaim") +
  ggplot2::annotate("text", x = 8.5, y = 700, label = "High ratings \n & High gross") +
  theme(plot.title = element_text(hjust = 0.5))

Correlation Heatmap

ggcorr(movie_metadata, label = TRUE, label_round = 2, label_size = 2.8, size = 2, hjust = .85) +
  ggtitle("Correlation Heatmap") +
  theme(plot.title = element_text(hjust = 0.5))

## Warning in ggcorr(movie_metadata, label = TRUE, label_round = 2, label_size
## = 2.8, : data in column(s) 'director_name', 'actor_2_name', 'actor_1_name',
## 'movie_title', 'actor_3_name', 'plot_keywords', 'movie_imdb_link',
## 'language', 'country', 'content_rating', 'genre', 'vote_bucket' are not
## numeric and were ignored

Based on the heatmap, we can see some high correlations (greater than 0.7) between predictors.

According to the highest correlation value 0.95, we find actor_1_facebook_likes is highly correlated with the cast_total_facebook_likes, and both actor2 and actor3 are also somehow correlated to the total. So we want to modify them into two variables: actor_1_facebook_likes and other_actors_facebook_likes.

There are high correlations among num_voted_users, num_user_for_reviews and num_critic_for_reviews.

Sentiment Analysis

options(scipen = 999)

IMDB <- read.csv("../data/real_deal.csv")

#Removing Duplicates
IMDB <- IMDB[!duplicated(IMDB), ]

#Removing White-Spaces and Special Characters
IMDB$movie_title <- gsub("Â", "", as.character(factor(IMDB$movie_title)))
IMDB$movie_title <- str_trim(IMDB$movie_title, side = "right")

IMDB <- subset(IMDB, select = -c(genres))

colSums(sapply(IMDB, is.na))

##                     color             director_name 
##                         0                         0 
##    num_critic_for_reviews                  duration 
##                        49                        15 
##   director_facebook_likes    actor_3_facebook_likes 
##                       103                        23 
##              actor_2_name    actor_1_facebook_likes 
##                         0                         7 
##                     gross              actor_1_name 
##                       874                         0 
##               movie_title           num_voted_users 
##                         0                         0 
## cast_total_facebook_likes              actor_3_name 
##                         0                         0 
##      facenumber_in_poster             plot_keywords 
##                        13                         0 
##           movie_imdb_link      num_user_for_reviews 
##                         0                        21 
##                  language                   country 
##                         0                         0 
##            content_rating                    budget 
##                         0                       487 
##                title_year    actor_2_facebook_likes 
##                       107                        13 
##                imdb_score              aspect_ratio 
##                         0                       327 
##      movie_facebook_likes 
##                         0

#Plotting Facebook likes against IMDB score
ggplot(data = IMDB, aes(x = imdb_score, y = movie_facebook_likes)) +
  geom_point() +
  stat_smooth(method="lm")

#Plotting Aspect Ratio against Facebook likes
IMDB %>% 
  filter(aspect_ratio==1.85 | aspect_ratio==2.35) %>%
  mutate(aspect_ratio=as.character((aspect_ratio))) %>%
  ggplot() +
  geom_point(aes(x=aspect_ratio, y=movie_facebook_likes))

#Constructing Top 20
keywords_split <- str_split(IMDB$plot_keywords, pattern="[|]", n=5)

keywords_matrix <- do.call(rbind, strsplit(as.character(IMDB$plot_keywords), "[|]"))

## Warning in (function (..., deparse.level = 1) : number of columns of result
## is not a multiple of vector length (arg 99)

keywords_df <- as.data.frame(keywords_matrix)

names(keywords_df) <- c("one", "two", "three", "four", "five")

keywords_one_col <- gather(keywords_df) %>% 
  select(value)

keywords_one_col_freq <- keywords_one_col %>%
  group_by(value) %>%
  tally()

top_20 <- keywords_one_col_freq %>%
  select(value, n) %>%
  top_n(20)

## Selecting by n

movies_with_keywords <- data.frame()
IMDB_keyword_movie <- data.frame()

keywords_one_col %>%
  group_by(value) %>% 
  tally() %>% 
  filter(n > 30) %>% 
  ggplot() +
  geom_bar(aes(x = value, y=n), stat="identity") +
  theme(axis.text.x = element_text(angle = 90, hjust = 1)) 

top_20

## # A tibble: 20 x 2
##    value                  n
##    <chr>              <int>
##  1 alien                 82
##  2 boy                   72
##  3 death                132
##  4 dog                   58
##  5 drugs                 66
##  6 fbi                   71
##  7 female protagonist    58
##  8 friend               165
##  9 friendship            67
## 10 high school           89
## 11 island                57
## 12 love                 194
## 13 marriage              60
## 14 money                 61
## 15 murder               160
## 16 new york city         92
## 17 police               127
## 18 prison                62
## 19 revenge               70
## 20 school                73

#Placing Top 20 Words Against Movie Success

IMDB_true_false <- IMDB 
for (keyword in top_20$value) {
  IMDB_true_false <- cbind(IMDB_true_false, ifelse(str_detect(IMDB$plot_keywords, keyword), "TRUE", "FALSE"))
}

for (i in 1:20) {
  reference <- 27
  names(IMDB_true_false)[reference + i] <- top_20$value[i]  
}

truey <- data.frame()
for (keyword in top_20$value) {
  truey <- rbind(truey, IMDB_true_false %>%
                            filter(get(keyword) == TRUE) %>% select(movie_title, gross, imdb_score, movie_facebook_likes, plot_keywords)) %>%
    distinct(movie_title, .keep_all = T)
}



falsy <- data.frame()
for (keyword in top_20$value) {
  falsy <- rbind(falsy, IMDB_true_false %>%
                            filter(get(keyword) == FALSE) %>% select(movie_title, gross, imdb_score, movie_facebook_likes, plot_keywords)) %>%
    distinct(movie_title, .keep_all = T)
}

truey <- truey %>%
  mutate(tri = "Top 20 Word")

falsy <- falsy %>%
  mutate(tri = "NOT Top 20 Word")

truey_falsy <- full_join(falsy, truey, by = c("movie_title", "gross", "imdb_score", "movie_facebook_likes", "plot_keywords"))

truey_falsy <- truey_falsy %>%
  mutate(tri = coalesce(tri.y, tri.x)) %>%
  select(movie_title, gross, imdb_score, movie_facebook_likes, plot_keywords, tri)

truey_falsy <-  truey_falsy %>%
  group_by(tri) %>%
  na.omit() %>%
  mutate(avg = mean(gross))

truey_falsy_graph <- summarise(truey_falsy, avg = mean(gross))

truey_falsy_graph %>%
  ggplot() +
  geom_bar(aes(x = tri, y=avg, fill=tri), stat="identity", position="stack") +
  theme(axis.text.x = element_blank()) 

#Sentiment

keywords_from_split <- data.frame(lapply(keywords_split, "length<-", max(lengths(keywords_split))))

#Creating a list of titles and years seperatored by "|"
titles <-  IMDB %>%
  select(movie_title)
years <- IMDB %>%
  select(title_year)

titles_years_list <- list()

for (x in 1:4998) {
  seperator="|"
  titles_years_list <- c(titles_years_list, paste(titles$movie_title[x], years$title_year[x], sep="|"))
}

#Renaming columns to movie names
movie_name_list <- IMDB$movie_title
names(keywords_from_split) <- titles_years_list

#Adding column to the begining
key_names <- c('key_word_1', 'key_word_2', 'key_word_3', 'key_word_4', 'key_word_5')
keywords_from_split <- cbind(test_keys = key_names, keywords_from_split)

#Moving columns to rows
keywords_from_split <- melt(keywords_from_split, id = "test_keys")

#Creating new column for year
keywords_from_split_matrix <- do.call(rbind, strsplit(as.character(keywords_from_split$variable), "[|]"))
keywords_from_split <- cbind(keywords_from_split, keywords_from_split_matrix)
names(keywords_from_split) <- c("Key #", "Combined", "Keyword", "Title", "Year")
keywords_from_split = keywords_from_split %>%
  select(`Key #`, Title, Year, Keyword)

#Replacing blank cells within keywords to NA's
keywords_from_split$Keyword[keywords_from_split$Keyword == ""] <- NA
#Removing rows containing NA's
keywords_from_split <- na.omit(keywords_from_split)

#All unique years
all_years <- keywords_from_split %>% select(Year)
all_years <- distinct(all_years)
all_years <- na.omit(all_years)
all_years <- all_years %>%
  filter(Year != "NA")

#Function for sentiment per year
yearly_sentiment <- function(year, df) {
  amount <- nrow(df %>%
    select(Year) %>%
    filter(Year == year))
  df <- df %>%
    filter(Year == year)
  sentiments <- get_nrc_sentiment(as.character(df[4]))
  for (i in 1:length(sentiments)) {
    sentiments[i] <- sentiments[i]/amount
  }
  year_sentiment <- cbind(year, sentiments)
  return (year_sentiment)
}

sentiments <- data.frame()

#For-loop to capture all years
for (i in all_years$Year) {
  sentiments <- rbind(sentiments,yearly_sentiment(i, keywords_from_split))
}

#Making years integers
sentiments$year <- strtoi(sentiments$year)

#Sort by year
sentiments <- sentiments[with(sentiments, order(year)), ]
#sentiments <- sentiments[order(year), ]

#Heatmap for sentiments
rnames <- sentiments[,1]
mat_sentiments <- data.matrix(sentiments[,2:ncol(sentiments)])
rownames(mat_sentiments) <- rnames
mat_sentiments <- t(mat_sentiments)

df_sentiment <-  as.data.frame(mat_sentiments)
names_emotions <- c("anger", "anticipation", "disgust","fear","joy","sadness","surprise","trust","negative","positive")

sentiments_graph <- cbind(names_emotions, df_sentiment)

#Run if there is a problem with heatmap
dev.off()

## null device 
##           1

#Heatmap
heatmap.2(mat_sentiments, Rowv=NA, Colv=NA, scale="row", col=colorRampPalette(c("white","darkblue")),  margins=c(5,10), trace = "none")

## Warning in heatmap.2(mat_sentiments, Rowv = NA, Colv = NA, scale = "row", :
## Discrepancy: Rowv is FALSE, while dendrogram is `both'. Omitting row
## dendogram.

## Warning in heatmap.2(mat_sentiments, Rowv = NA, Colv = NA, scale = "row", :
## Discrepancy: Colv is FALSE, while dendrogram is `column'. Omitting column
## dendogram.

#Filtering sentiments graph
sentiments_graph_filter <- sentiments %>%
  filter(year >= 2000)

#Other graphs
# Showing trends between sentiment from the 2000's 
ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = anger)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = anticipation)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = disgust)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = fear)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = joy)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = sadness)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = surprise)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = trust)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = negative)) + 
  geom_point(alpha = 0.5) + 
  geom_line()

ggplot(sentiments_graph_filter, aes(x = as.numeric(year), y = positive)) + 
  geom_point(alpha = 0.5) + 
  geom_line()